Visual Basic Toolbox/Visual Basic Toolbox (P.I.E.)(1996).ISO/dvc_cntl/mouseset/mousedmo.frm

Text File | 1995-05-18 | 6KB | 208 lines

VERSION 2.00
Begin Form Form1
   BackColor       =   &H00C0C0C0&
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Mouse Set and Restore Demo"
   ClientHeight    =   1005
   ClientLeft      =   2790
   ClientTop       =   1905
   ClientWidth     =   6150
   Height          =   1440
   Icon            =   MOUSEDMO.FRX:0000
   Left            =   2715
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   1005
   ScaleWidth      =   6150
   Top             =   1545
   Width           =   6300
   Begin Timer Timer1
      Left            =   360
      Top             =   480
   End
   Begin SSPanel Panel3D2
      Align           =   2  'Align Bottom
      BorderWidth     =   2
      ForeColor       =   &H00000000&
      Height          =   615
      Left            =   0
      TabIndex        =   1
      Top             =   390
      Width           =   6150
      Begin CommandButton Command1
         Caption         =   "&Help"
         Height          =   375
         Index           =   2
         Left            =   4800
         TabIndex        =   4
         Top             =   120
         Width           =   1215
      End
      Begin CommandButton Command1
         Caption         =   "E&xit"
         Height          =   375
         Index           =   1
         Left            =   3480
         TabIndex        =   3
         Top             =   120
         Width           =   1215
      End
      Begin CommandButton Command1
         Caption         =   "&Start Demo"
         Height          =   375
         Index           =   0
         Left            =   120
         TabIndex        =   2
         Top             =   120
         Width           =   3255
      End
   End
   Begin SSPanel Panel3D1
      Align           =   1  'Align Top
      BevelInner      =   1  'Inset
      FloodColor      =   &H000000C0&
      FloodShowPct    =   0   'False
      FloodType       =   1  'Left To Right
      ForeColor       =   &H00000000&
      Height          =   375
      Left            =   0
      TabIndex        =   0
      Top             =   0
      Width           =   6150
   End
End
' MouseDmo.Frm - Demo MouseSet and MouseRestore
' 95/05/18 Copyright 1995, Larry Rebich, The Bridge, Inc.

    Option Explicit
    DefInt A-Z

' Command Indexes
    Const IndexStart = 0
    Const IndexExit = 1
    Const IndexHelp = 2

' MousePointer
    Dim mArray(0 To 12) As String
    Const m0 = "DEFAULT"        ' 0 - Default
    Const m1 = "ARROW"          ' 1 - Arrow
    Const m2 = "CROSSHAIR"      ' 2 - Cross
    Const m3 = "IBEAM"          ' 3 - I-Beam
    Const m4 = "ICON_POINTER"   ' 4 - Icon
    Const m5 = "SIZE_POINTER"   ' 5 - Size
    Const m6 = "SIZE_NE_SW"     ' 6 - Size NE SW
    Const m7 = "SIZE_N_S"       ' 7 - Size N S
    Const m8 = "SIZE_NW_SE"     ' 8 - Size NW SE
    Const m9 = "SIZE_W_E"       ' 9 - Size W E
    Const mA = "UP_ARROW"       ' 10 - Up Arrow
    Const mB = "HOURGLASS"      ' 11 - Hourglass
    Const mC = "NO_DROP"        ' 12 - No drop

' Other
    Dim SavedCaption As String
    Const capStart = "&Start"
    Const capStop = "&Stop"

Sub Command1_Click (Index As Integer)
    Select Case Index
        Case IndexStart
            If Command1(Index).Caption = capStop Then
                StopDemo
            Else
                DoDemo
            End If
        Case IndexExit
            End
        Case IndexHelp
            DoHelp
    End Select
End Sub

Sub DoDemo ()
    Timer1.Interval = 500
    Timer1_Timer
    Command1(IndexStart).Caption = capStop
End Sub

Sub DoHelp ()
    Dim a As String
    Dim x As Integer
    a = App.Path
    If Right$(a, 1) <> "\" Then a = a & "\"
    a = a & "MouseDmo.Hlp"
    x = Shell("WinHelp.Exe " & a, 1)
End Sub

Sub Form_Load ()
    Move (Screen.Width - Width) \ 2, (Screen.Height - Height) \ 2   'center
    SavedCaption = Caption          'save if stop pressed
    LoadMArray          'set the mouse pointer description array
    Const ACTIVE_TITLE_BAR = &H80000002     ' Active window caption.
    Panel3D1.FloodColor = ACTIVE_TITLE_BAR  ' Set it
End Sub

Sub LoadMArray ()
    mArray(0) = m0
    mArray(1) = m1
    mArray(2) = m2
    mArray(3) = m3
    mArray(4) = m4
    mArray(5) = m5
    mArray(6) = m6
    mArray(7) = m7
    mArray(8) = m8
    mArray(9) = m9
    mArray(10) = mA
    mArray(11) = mB
    mArray(12) = mC
End Sub

Function mName (iWhich As Long) As String
    'return the mouse setting description
    mName = mArray(iWhich)
End Function

Sub StopDemo ()
    Command1(IndexStart).Caption = capStart
    Timer1.Interval = 0
    DoEvents
    Caption = SavedCaption
    Panel3D1.FloodPercent = 0
    Screen.MousePointer = 0
End Sub

Sub Timer1_Timer ()
    If Command1(IndexStart).Caption = capStart Then Exit Sub
    Static iCount As Integer        'counter
    Static iDirection As Integer    'which direction are we going
    Const iBump = 10
    Const lMax& = 120
    Const iDown = True
    Const iUp = False
    Dim lCurMouse As Long           'current mouse
    Dim dPct As Double
    If iDirection = iDown Then      'set the counter
        iCount = iCount - iBump
        If iCount <= 0 Then
            iCount = 0
            iDirection = iUp
        End If
        Screen.MousePointer = MouseRestore()    'restore the mouse
        lCurMouse = Screen.MousePointer
        Caption = "MouseRestore()  [" & mName(lCurMouse) & " (" & lCurMouse & ")]"
    Else
        iCount = iCount + iBump
        If iCount >= lMax Then
            iCount = lMax
            iDirection = iDown
        End If
        Screen.MousePointer = MouseSet(iCount \ iBump)  'set the mouse
        lCurMouse = Screen.MousePointer
        Caption = "MouseSet(" & mName(lCurMouse) & ")  [" & lCurMouse & "]"
    End If
    lCurMouse = Screen.MousePointer
    dPct = (lCurMouse / lMax) * 1000&
    Panel3D1.FloodPercent = dPct
End Sub